perm filename BARS.F4[RST,LCS] blob
sn#239709 filedate 1976-10-05 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION A(510),LN(50),KBAR(512)
C00005 ENDMK
Cā;
DIMENSION A(510),LN(50),KBAR(512)
EQUIVALENCE (KT,KBAR),(TX,KBAR(2)),(A,KBAR(3))
DATA DIV/4.0/
CALL GETFIL('BARS')
CALL FASTIN(KBAR,512)
15 TYPE 10,KT,TX
10 FORMAT(' BARS=',I3,' SPACE=',F9.2/' HOW MANY LINES '$)
ACCEPT 11,T
11 FORMAT(5F)
17 B=0
DO 16 K=1,KT
16 B=B+A(K)
AV=B/T
X=AV
JT=T
NN=KT/JT
NX=KT-NN*JT
DO 308 K=1,JT-NX
C NN=AVG. NUM OF BARS/LINE
308 LN(K)=NN
IF(NX.EQ.0)GO TO 309
DO 310 K=JT-NX+1,JT
310 LN(K)=NN+1
J=0
309 DO 311 K=1,JT
L=LN(K)
B=0
DO 312 KK=1,L
J=J+1
312 B=B+A(J)
IF(K.EQ.1)GO TO 311
311 T=B
J=0
K=0
7 Y=0
LAST=J
N=0
M=J+1
1 J=J+1
N=N+1
Y=Y+A(J)
IF(J.EQ.KT)GO TO 2
IF(Y.LE.X)GO TO 1
3 IF(Y-X.LT.X-Y+A(J))GO TO 2
Y=Y-A(J)
J=J-1
N=N-1
2 X=X+(X-Y)/DIV
K=K+1
LN(K)=N
B=ABS(Y-T)
IF(K.EQ.1)GO TO 9
IF(Y.LT.T)GO TO 22
C NEXT TO SHIFT BAR TO NEXT OR PREV. LINE IF DESIRED.
IF(B.GT.A(M))GO TO 21
GO TO 9
22 IF(B.LE.A(LAST))GO TO 9
IF(Y.GT.T)GO TO 20
JK=K-1
JJ=K
B=A(LAST)
GO TO 20
21 JJ=K-1
JK=K
B=-A(M)
20 LN(JJ)=LN(JJ)+1
C SHIFT BAR FROM ONE LINE TO OTHER IF DESIRED
LN(JK)=LN(JK)-1
Y=Y+B
9 T=Y
IF(J.LT.KT)GO TO 7
J=1
TYPE 6,AV
DO 5 K=1,JT
L=LN(K)-1+J
T=0
DO 8 M=J,L
8 T=T+A(M)
TYPE 6,(A(N),N=J,L),T
5 J=L+1
6 FORMAT(1X8F6.2)
GO TO 15
END